home *** CD-ROM | disk | FTP | other *** search
- unit AutomationServer1ClassU;
-
- interface
-
- uses
- ComObj, ActiveX, AutomationServer1_TLB;
-
- type
- TClock = class(TAutoObject, IClock)
- private
- RegistrationCookie: Integer;
- protected
- function Get_DateAndTime: TDateTime; safecall;
- public
- procedure Initialize; override;
- destructor Destroy; override;
- end;
-
- implementation
-
- uses
- ComServ, SysUtils, Forms, Windows;
-
- procedure TClock.Initialize;
- begin
- inherited;
- OleCheck(RegisterActiveObject(Self as IUnknown, Class_Clock,
- ActiveObject_Weak, RegistrationCookie));
- Application.MessageBox('COM object starting', 'Information',
- MB_OK or MB_ICONEXCLAMATION);
- end;
-
- destructor TClock.Destroy;
- begin
- Application.MessageBox('COM object ending', 'Information',
- MB_OK or MB_ICONEXCLAMATION);
- OleCheck(RevokeActiveObject(RegistrationCookie, nil));
- inherited
- end;
-
- function TClock.Get_DateAndTime: TDateTime;
- begin
- Result := Now
- end;
-
- initialization
- TAutoObjectFactory.Create(ComServer, TClock, Class_Clock,
- ciSingleInstance, tmApartment);
- end.
-